home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp3.arc / PIBMENUS.PAS next >
Pascal/Delphi Source File  |  1985-09-04  |  46KB  |  967 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           PIBMENUS.PAS   --- Menu Routines for Turbo Pascal          *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985                                 *)
  8. (*           Version 1.1: March, 1985                                   *)
  9. (*           Version 1.2: May, 1985                                     *)
  10. (*           Version 2.0: June, 1985                                    *)
  11. (*           Version 2.1: July, 1985                                    *)
  12. (*                                                                      *)
  13. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  14. (*           Note:  I have checked these on Zenith 151s under           *)
  15. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  16. (*                                                                      *)
  17. (*  History: These routines represent my substantial upgrading of the   *)
  18. (*           simple menu routines written by Barry Abrahamsen which     *)
  19. (*           I believe appeared originally in the TUG newsletter.       *)
  20. (*           The windowing facility provides windows similar to those   *)
  21. (*           implemented in QMODEM by John Friel III.                   *)
  22. (*                                                                      *)
  23. (*           Version 2.0 of these adds the exploding windows feature    *)
  24. (*           as well the use-selectable box-drawing characters.         *)
  25. (*           The exploding box algorithm is derived from one by         *)
  26. (*           Jim Everingham.                                            *)
  27. (*                                                                      *)
  28. (*           Note that the routines present in PIBSCREN.PAS were        *)
  29. (*           originally part of the PIBMENUS.PAS file.  With version    *)
  30. (*           2.0 of PibMenus, PIBMENUS.PAS is split into the screen-    *)
  31. (*           handling routines in PIBSCREN.PAS and the actual menu      *)
  32. (*           routines in PIBMENUS.PAS.                                  *)
  33. (*                                                                      *)
  34. (*           Suggestions for improvements or corrections are welcome.   *)
  35. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  36. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  37. (*                                                                      *)
  38. (*           If you use this code in your own programs, please be nice  *)
  39. (*           and give all of us credit.                                 *)
  40. (*                                                                      *)
  41. (*----------------------------------------------------------------------*)
  42. (*                                                                      *)
  43. (*  Needs:  These routines need the include files MINMAX.PAS,           *)
  44. (*          GLOBTYPE.PAS, ASCII.PAS, and PIBSCREN.PAS. These files      *)
  45. (*          are not included here, since Turbo Pascal regrettably does  *)
  46. (*          not allow nested includes.                                  *)
  47. (*                                                                      *)
  48. (*----------------------------------------------------------------------*)
  49. (*                                                                      *)
  50. (*  What these routines do:                                             *)
  51. (*                                                                      *)
  52. (*    These routines provide a straight-forward menu-selection          *)
  53. (*    facility, similar to that used in programs like Lotus.  A pop-up  *)
  54. (*    window holds the menu.  The menu is contained in a frame.  The    *)
  55. (*    items are displayed within the frame.  The currently selected     *)
  56. (*    item is highlighted in reverse video.  You move up and down in    *)
  57. (*    the list of menu items by using the up and down arrow keys, or    *)
  58. (*    the space bar.  To make a selection, hit the Enter (Return) key.  *)
  59. (*                                                                      *)
  60. (*    Alternatively, you may hit the first character of a menu item.    *)
  61. (*    The first menu item found with that initial letter is selected.   *)
  62. (*                                                                      *)
  63. (*    The characters comprising the menu box are user-selectable.       *)
  64. (*    In addition, menus may just "pop up" onto the screen, or may      *)
  65. (*    "explode" onto the screen.                                        *)
  66. (*                                                                      *)
  67. (*----------------------------------------------------------------------*)
  68. (*                                                                      *)
  69. (*  Use:                                                                *)
  70. (*                                                                      *)
  71. (*     (1)  Define a variable of type Menu_Type, say, MYMENU.           *)
  72. (*                                                                      *)
  73. (*     (2)  Define the following entries in MYMENU:                     *)
  74. (*                                                                      *)
  75. (*             Menu_Size    --- Number of entries in this menu          *)
  76. (*             Menu_Title   --- Title for the menu                      *)
  77. (*             Menu_Row     --- Row where menu should appear (upper LHC *)
  78. (*             Menu_Column  --- Column where menu should appear         *)
  79. (*             Menu_Width   --- Width of menu                           *)
  80. (*             Menu_Height  --- Height of menu                          *)
  81. (*             Menu_Default --- Ordinal of the default menu entry       *)
  82. (*             Menu_Tcolor  --- Color to display menu text              *)
  83. (*             Menu_Bcolor  --- Color for menu background               *)
  84. (*             Menu_Fcolor  --- Color for menu frame box                *)
  85. (*                                                                      *)
  86. (*     (3)  Now for each of Menu_Size Menu_Entries, define:             *)
  87. (*             Menu_Text   --- Text of menu item                        *)
  88. (*                                                                      *)
  89. (*     (4)  Optionally call  Menu_Set_Box_Chars  to define the          *)
  90. (*          characters used to form the menu box.                       *)
  91. (*                                                                      *)
  92. (*     (5)  Optionally call Menu_Set_Explode to set the menus as either *)
  93. (*          exploding or pop-up.                                        *)
  94. (*                                                                      *)
  95. (*     (6)  Optionally call Menu_Set_Beep to turn beeping on/off.       *)
  96. (*                                                                      *)
  97. (*     (7)  Call  Menu_Display_Choices  to display menu.  The default   *)
  98. (*          menu choice will be highlighted.                            *)
  99. (*                                                                      *)
  100. (*     (8)  Call  Menu_Get_Choice  to retrieve menu choice.  The up and *)
  101. (*          down arrows, and the space bar, can be used to move         *)
  102. (*          through the menu items.  Each item is highlighted in turn.  *)
  103. (*          Whichever item is highlighted when a carriage return is     *)
  104. (*          entered is returned as the chosen item.                     *)
  105. (*                                                                      *)
  106. (*     Note the the routine Set_Turbo_Version need not be called any    *)
  107. (*     longer, thanks to a version-independent fix suggested by         *)
  108. (*     Mike Harrington.                                                 *)
  109. (*                                                                      *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. (*----------------------------------------------------------------------*)
  113. (*                   Menu constants, types, and variables               *)
  114. (*----------------------------------------------------------------------*)
  115.  
  116. CONST
  117.  
  118.    Up_arrow         = ^E;    (* move up in menu code   *)
  119.    Down_arrow       = ^X;    (* move down in menu code *)
  120.    Space_bar        = #32;   (* space bar              *)
  121.    Ch_cr            = #13;   (* Carriage return *)
  122.    Ch_esc           = #27;   (* Escape *)
  123.    Ch_bell          = #07;   (* Bell *)
  124.  
  125.    Max_Menu_Items   = 18;    (* Maximum number of menu choices *)
  126.  
  127.    Dont_Erase_Menu  = FALSE;
  128.    Erase_Menu       = TRUE;
  129.  
  130. TYPE
  131.  
  132.    String40   = STRING[40]         (* Menu entry string type               *);
  133.    String60   = STRING[60]         (* Menu title string type               *);
  134.  
  135.    Menu_Entry = RECORD
  136.       Menu_Item_Text   : String40; (* Text of entry                        *)
  137.       Menu_Item_Row    : BYTE;     (* Row position of menu item            *)
  138.       Menu_Item_Column : BYTE;     (* Column position of menu item         *)
  139.    END;
  140.  
  141.    Menu_Type = RECORD
  142.       Menu_Size     : 1 .. Max_Menu_Items;    (* No. of items in menu      *)
  143.       Menu_Title    : String60;               (* Menu title                *)
  144.       Menu_Row      : BYTE;                   (* Row position of menu      *)
  145.       Menu_Column   : BYTE;                   (* Column position of menu   *)
  146.       Menu_Width    : BYTE;                   (* Width of menu             *)
  147.       Menu_Height   : BYTE;                   (* Height of menu            *)
  148.       Menu_Default  : 1 .. Max_Menu_Items;    (* Default value position    *)
  149.       Menu_TColor   : BYTE;                   (* Foreground text color     *)
  150.       Menu_BColor   : BYTE;                   (* BackGround color          *)
  151.       Menu_FColor   : BYTE;                   (* Frame color               *)
  152.  
  153.                                               (* Menu items themselves     *)
  154.       Menu_Entries  : ARRAY[ 1 .. Max_Menu_Items ] Of Menu_Entry;
  155.    END;
  156.  
  157. (* STRUCTURED *) CONST
  158.    Menu_Explode_Mode : BOOLEAN     (* TRUE to use exploding menus *)
  159.                        = FALSE;
  160.  
  161.    Menu_Beep_Mode    : BOOLEAN     (* TRUE to beep on errors      *)
  162.                        = TRUE;
  163.  
  164. (* STRUCTURED *) CONST
  165.                                    (* Box-drawing characters for menus *)
  166.    Menu_Box_Chars : RECORD
  167.                        Top_Left_Corner     : CHAR;
  168.                        Top_Line            : CHAR;
  169.                        Top_Right_Corner    : CHAR;
  170.                        Right_Line          : CHAR;
  171.                        Bottom_Right_Corner : CHAR;
  172.                        Bottom_Line         : CHAR;
  173.                        Bottom_Left_Corner  : CHAR;
  174.                        Left_Line           : CHAR;
  175.                     END
  176.                     =
  177.                     (  Top_Left_Corner     : '╒';
  178.                        Top_Line            : '═';
  179.                        Top_Right_Corner    : '╕';
  180.                        Right_Line          : '│';
  181.                        Bottom_Right_Corner : '╛';
  182.                        Bottom_Line         : '═';
  183.                        Bottom_Left_Corner  : '╘';
  184.                        Left_Line           : '│'  );
  185.  
  186. (*----------------------------------------------------------------------*)
  187. (*            Menu_Set_Explode --- Set explode mode on or off           *)
  188. (*----------------------------------------------------------------------*)
  189.  
  190. PROCEDURE Menu_Set_Explode( Explode_ON : BOOLEAN );
  191.  
  192. (*----------------------------------------------------------------------*)
  193. (*                                                                      *)
  194. (*     Procedure:  Menu_Set_Explode                                     *)
  195. (*                                                                      *)
  196. (*     Purpose:    Turn exploding menus on or off                       *)
  197. (*                                                                      *)
  198. (*     Calling Sequence:                                                *)
  199. (*                                                                      *)
  200. (*        Menu_Set_Explode( Explode_ON : BOOLEAN );                     *)
  201. (*                                                                      *)
  202. (*           Explode_ON --- TRUE to use exploding menus,                *)
  203. (*                          FALSE to use pop-up menus                   *)
  204. (*                                                                      *)
  205. (*     Calls:   None                                                    *)
  206. (*                                                                      *)
  207. (*----------------------------------------------------------------------*)
  208.  
  209. BEGIN (* Menu_Set_Explode *)
  210.  
  211.    Menu_Explode_Mode := Explode_ON;
  212.  
  213. END   (* Menu_Set_Explode *);
  214.  
  215. (*----------------------------------------------------------------------*)
  216. (*               Menu_Set_Beep --- Set beep mode on or off              *)
  217. (*----------------------------------------------------------------------*)
  218.  
  219. PROCEDURE Menu_Set_Beep( Beep_ON : BOOLEAN );
  220.  
  221. (*----------------------------------------------------------------------*)
  222. (*                                                                      *)
  223. (*     Procedure:  Menu_Set_Beep                                        *)
  224. (*                                                                      *)
  225. (*     Purpose:    Turn beeping (errors, etc.) on or off                *)
  226. (*                                                                      *)
  227. (*     Calling Sequence:                                                *)
  228. (*                                                                      *)
  229. (*        Menu_Set_Beep( Beep_ON : BOOLEAN );                           *)
  230. (*                                                                      *)
  231. (*           Beep_ON --- TRUE to allow beeps,                           *)
  232. (*                       FALSE to disallow beeps.                       *)
  233. (*                                                                      *)
  234. (*     Calls:   None                                                    *)
  235. (*                                                                      *)
  236. (*----------------------------------------------------------------------*)
  237.  
  238. BEGIN (* Menu_Set_Beep *)
  239.  
  240.    Menu_Beep_Mode := Beep_ON;
  241.  
  242. END   (* Menu_Set_Beep *);
  243.  
  244. (*----------------------------------------------------------------------*)
  245. (*     Menu_Set_Box_Chars --- Set box drawing characters for menus      *)
  246. (*----------------------------------------------------------------------*)
  247.  
  248. PROCEDURE Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;
  249.                               Top_Line            : CHAR;
  250.                               Top_Right_Corner    : CHAR;
  251.                               Right_Line          : CHAR;
  252.                               Bottom_Right_Corner : CHAR;
  253.                               Bottom_Line         : CHAR;
  254.                               Bottom_Left_Corner  : CHAR;
  255.                               Left_Line           : CHAR  );
  256.  
  257. (*----------------------------------------------------------------------*)
  258. (*                                                                      *)
  259. (*     Procedure:  Menu_Set_Box_Chars                                   *)
  260. (*                                                                      *)
  261. (*     Purpose:    Set box characters for drawing menu boxes            *)
  262. (*                                                                      *)
  263. (*     Calling Sequence:                                                *)
  264. (*                                                                      *)
  265. (*        Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;               *)
  266. (*                            Top_Line            : CHAR;               *)
  267. (*                            Top_Right_Corner    : CHAR;               *)
  268. (*                            Right_Line          : CHAR;               *)
  269. (*                            Bottom_Right_Corner : CHAR;               *)
  270. (*                            Bottom_Line         : CHAR;               *)
  271. (*                            Bottom_Left_Corner  : CHAR;               *)
  272. (*                            Left_Line           : CHAR  );            *)
  273. (*                                                                      *)
  274. (*           --- arguments are what their names suggest.                *)
  275. (*                                                                      *)
  276. (*                                                                      *)
  277. (*     Calls:   None                                                    *)
  278. (*                                                                      *)
  279. (*----------------------------------------------------------------------*)
  280.  
  281. BEGIN (* Menu_Set_Box_Chars *)
  282.  
  283.    Menu_Box_Chars.Top_Left_Corner     := Top_Left_Corner;
  284.    Menu_Box_Chars.Top_Line            := Top_Line;
  285.    Menu_Box_Chars.Top_Right_Corner    := Top_Right_Corner;
  286.    Menu_Box_Chars.Right_Line          := Right_Line;
  287.    Menu_Box_Chars.Bottom_Right_Corner := Bottom_Right_Corner;
  288.    Menu_Box_Chars.Bottom_Line         := Bottom_Line;
  289.    Menu_Box_Chars.Bottom_Left_Corner  := Bottom_Left_Corner;
  290.    Menu_Box_Chars.Left_Line           := Left_Line;
  291.  
  292. END   (* Menu_Set_Box_Chars *);
  293.  
  294. (*----------------------------------------------------------------------*)
  295. (*                Draw_Menu_Frame --- Draw a Frame                      *)
  296. (*----------------------------------------------------------------------*)
  297.  
  298. PROCEDURE Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  299.                            LowerRightX, LowerRightY : INTEGER;
  300.                            Frame_Color, Title_Color : INTEGER;
  301.                            Menu_Title: AnyStr );
  302.  
  303. (*----------------------------------------------------------------------*)
  304. (*                                                                      *)
  305. (*     Procedure:  Draw_Menu_Frame                                      *)
  306. (*                                                                      *)
  307. (*     Purpose:    Draws a titled frame using PC graphics characters    *)
  308. (*                                                                      *)
  309. (*     Calling Sequence:                                                *)
  310. (*                                                                      *)
  311. (*        Draw_Menu_Frame( UpperLeftX,  UpperLeftY,                     *)
  312. (*                         LowerRightX, LowerRightY,                    *)
  313. (*                         Frame_Color, Title_Color : INTEGER;          *)
  314. (*                         Menu_Title: AnyStr );                        *)
  315. (*                                                                      *)
  316. (*           UpperLeftX,  UpperLeftY  --- Upper left coordinates        *)
  317. (*           LowerRightX, LowerRightY --- Lower right coordinates       *)
  318. (*           Frame_Color              --- Color for frame               *)
  319. (*           Title_Color              --- Color for title text          *)
  320. (*           Menu_Title               --- Menu Title                    *)
  321. (*                                                                      *)
  322. (*     Calls:   GoToXY                                                  *)
  323. (*              Window                                                  *)
  324. (*              ClrScr                                                  *)
  325. (*              Dupl                                                    *)
  326. (*              Draw_Box (internal)                                     *)
  327. (*              Do_Explosion (internal)                                 *)
  328. (*                                                                      *)
  329. (*     Remarks:                                                         *)
  330. (*                                                                      *)
  331. (*        The area inside the frame is cleared after the frame is       *)
  332. (*        drawn.  If a box without a title is desired, enter a null     *)
  333. (*        string for a title.                                           *)
  334. (*                                                                      *)
  335. (*----------------------------------------------------------------------*)
  336.  
  337. VAR
  338.    I  : INTEGER;
  339.    L  : INTEGER;
  340.    LT : INTEGER;
  341.    XM : INTEGER;
  342.    YM : INTEGER;
  343.    XS : INTEGER;
  344.    YS : INTEGER;
  345.    R  : REAL;
  346.    X1 : INTEGER;
  347.    X2 : INTEGER;
  348.    Y1 : INTEGER;
  349.    Y2 : INTEGER;
  350.    XM1: INTEGER;
  351.    YM1: INTEGER;
  352.    Knt: INTEGER;
  353.  
  354. (*----------------------------------------------------------------------*)
  355.  
  356. PROCEDURE Draw_Box( X1, Y1, X2, Y2 : INTEGER;
  357.                     Frame_Color    : INTEGER;
  358.                     Title_Color    : INTEGER;
  359.                     Title          : AnyStr   );
  360.  
  361. VAR
  362.    I  : INTEGER;
  363.    LT : INTEGER;
  364.  
  365. BEGIN (* Draw_Box *)
  366.  
  367.    Window( 1, 1, 80, 25 );
  368.  
  369.    LT := LENGTH( Title );
  370.  
  371.    IF LT > 0 THEN
  372.       BEGIN
  373.          WriteSXY( Menu_Box_Chars.Top_Left_Corner + '[ ',
  374.                    X1, Y1, Frame_Color );
  375.          WriteSXY( Title, X1 + 3, Y1, Title_Color );
  376.          WriteSXY( ' ]', X1 + LT + 3, Y1, Frame_Color );
  377.       END
  378.    ELSE
  379.       WriteSXY( Menu_Box_Chars.Top_Left_Corner +
  380.                 DUPL( Menu_Box_Chars.Top_Line , 4 ), X1, Y1, Frame_Color );
  381.  
  382.                                    (* Draw remainder of top of frame *)
  383.  
  384.    FOR I := ( X1 + LT + 5 ) TO ( X2 - 1 ) DO
  385.       WriteCXY( Menu_Box_Chars.Top_Line, I, Y1, Frame_Color );
  386.  
  387.    WriteCXY( Menu_Box_Chars.Top_Right_Corner, X2, Y1, Frame_Color );
  388.  
  389.                                   (* Draw sides of frame *)
  390.  
  391.    FOR I := ( Y1 + 1 ) TO ( Y2 - 1 ) DO
  392.       BEGIN
  393.          WriteCXY( Menu_Box_Chars.Left_Line,  X1, I, Frame_Color );
  394.          WriteCXY( Menu_Box_Chars.Right_Line, X2, I, Frame_Color );
  395.       END;
  396.                                   (* Draw bottom of frame     *)
  397.  
  398.    WriteCXY( Menu_Box_Chars.Bottom_Left_Corner, X1, Y2, Frame_Color );
  399.  
  400.    FOR I := ( X1 + 1 ) TO ( X2 - 1 ) DO
  401.       WriteCXY( Menu_Box_Chars.Bottom_Line, I, Y2, Frame_Color );
  402.  
  403.    WriteCXY( Menu_Box_Chars.Bottom_Right_Corner, X2, Y2, Frame_Color );
  404.  
  405. END   (* Draw_Box *);
  406.  
  407. (*----------------------------------------------------------------------*)
  408.  
  409. PROCEDURE Do_Explosion;
  410.  
  411. (*----------------------------------------------------------------------*)
  412. (*               --- Basic algorithm by Jim Everingham ---              *)
  413. (*----------------------------------------------------------------------*)
  414.  
  415. BEGIN (* Do_Explosion *)
  416.  
  417.    XM     := UpperLeftX + L DIV 2;
  418.    YM     := UpperLeftY + ( LowerRightY - UpperLeftY ) DIV 2;
  419.    X1     := UpperLeftX;
  420.    X2     := LowerRightX;
  421.    Y1     := UpperLeftY;
  422.    Y2     := LowerRightY;
  423.  
  424.    XM1    := XM;
  425.    YM1    := YM;
  426.                                     (* Figure out increments for *)
  427.                                     (* increasing boz dimensions *)
  428.                                     (* to produce explosion.     *)
  429.    IF ( XM > YM ) THEN
  430.        Knt    := TRUNC( L / 2 )
  431.    ELSE
  432.        Knt    := TRUNC( ( Y2 - Y1 ) / 2 );
  433.  
  434.    Y1     := Y1 - 1;
  435.    Y2     := Y2 - 1;
  436.  
  437.    X1     := X1 + 1;
  438.    X2     := X2 - 1;
  439.                                    (* Draw series of increasing     *)
  440.                                    (* size boxes, giving appearance *)
  441.                                    (* that box "explodes" from its  *)
  442.                                    (* center.                       *)
  443.  
  444.    FOR I := 1 TO ROUND( Knt / 3 ) DO
  445.       BEGIN
  446.                                    (* Adjust sides *)
  447.  
  448.          IF ( XM > ( X1 - 2 ) ) THEN
  449.             XM := XM - 3
  450.          ELSE IF ( XM > ( X1 - 1 ) ) THEN
  451.             XM := XM - 2
  452.          ELSE IF ( XM > X1 ) THEN
  453.             XM := XM - 1;
  454.  
  455.          IF ( XM1 < ( X2 + 2 ) ) THEN
  456.             XM1 := XM1 + 3
  457.          ELSE IF ( XM1 < ( X2 + 1 ) ) THEN
  458.             XM1 := XM1 + 2
  459.          ELSE IF ( XM1 < X2 ) THEN
  460.             XM1 := XM1 + 1;
  461.  
  462.                                    (* Adjust top and bottom *)
  463.  
  464.          IF ( YM > ( Y1 + 2 ) ) THEN
  465.             YM := YM - 3
  466.          ELSE IF ( YM > ( Y1 + 1 ) ) THEN
  467.             YM := YM - 2
  468.          ELSE IF ( YM > Y1 ) THEN
  469.             YM := YM - 1;
  470.  
  471.          IF ( YM1 < ( Y2 - 2 ) ) THEN
  472.             YM1 := YM1 + 3
  473.          ELSE IF ( YM1 < ( Y2 - 1 ) ) THEN
  474.             YM1 := YM1 + 2
  475.          ELSE IF ( YM1 < Y2 ) THEN
  476.             YM1 := YM1 + 1;
  477.  
  478.                                    (* Define new window *)
  479.  
  480.          WINDOW( XM + 1, YM + 1, XM1, YM1 );
  481.  
  482.                                    (* Clear it out      *)
  483.          Clear_Window;
  484.  
  485.                                    (* Draw box          *)
  486.  
  487.          Draw_Box( XM+1, YM+1, XM1, YM1, Frame_Color, Title_Color, '' );
  488.  
  489.       END (* For *);
  490.  
  491. END   (* Do_Explosion *);
  492.  
  493. (*----------------------------------------------------------------------*)
  494.  
  495. BEGIN (* Draw_Menu_Frame *)
  496.  
  497.    L  := LowerRightX - UpperLeftX;
  498.    LT := LENGTH( Menu_Title );
  499.                                    (* Adjust title length if necessary *)
  500.  
  501.    IF LT > ( L - 5 ) THEN Menu_Title[0] := CHR( L - 5 );
  502.  
  503.                                    (* Get explosion if requested *)
  504.  
  505.    IF Menu_Explode_Mode THEN Do_Explosion;
  506.  
  507.                                    (* Display actual menu frame       *)
  508.  
  509.    Draw_Box( UpperLeftX, UpperLeftY, LowerRightX, LowerRightY,
  510.              Frame_Color, Title_Color, Menu_Title );
  511.  
  512.                                    (* Establish scrolling window area *)
  513.  
  514.    Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  515.  
  516.                                    (* Clear out the window area       *)
  517.                                    (* KLUDGE NOTE:  ClrScr doesn't    *)
  518.                                    (* seem to work correctly on mono  *)
  519.                                    (* screens with Turbo 3.0 in the   *)
  520.                                    (* context of PibTerm.             *)
  521. (*
  522.    ClrScr;
  523. *)
  524.    FOR I := 1 TO ( LowerRightY - UpperLeftY - 1 ) DO
  525.       BEGIN
  526.          GoToXY( 1 , I );
  527.          ClrEol;
  528.       END;
  529.  
  530.    GoToXY( 1 , 1 );
  531.                                    (* Ensure proper color for text    *)
  532.    TextColor( Title_Color );
  533.  
  534. END   (* Draw_Menu_Frame *);
  535.  
  536. (*----------------------------------------------------------------------*)
  537. (*                Menu_Click --- Make short click noise                 *)
  538. (*----------------------------------------------------------------------*)
  539.  
  540. PROCEDURE Menu_Click;
  541.  
  542. (*----------------------------------------------------------------------*)
  543. (*                                                                      *)
  544. (*     Procedure:  Menu_Click                                           *)
  545. (*                                                                      *)
  546. (*     Purpose:    Clicks Terminal Bell                                 *)
  547. (*                                                                      *)
  548. (*     Calling Sequence:                                                *)
  549. (*                                                                      *)
  550. (*        Menu_Click;                                                   *)
  551. (*                                                                      *)
  552. (*     Calls:    Sound                                                  *)
  553. (*               Delay                                                  *)
  554. (*               NoSound                                                *)
  555. (*                                                                      *)
  556. (*----------------------------------------------------------------------*)
  557.  
  558. BEGIN (* Menu_Click *)
  559.  
  560.    IF Menu_Beep_Mode THEN
  561.       BEGIN
  562.          Sound( 2000 );
  563.          DELAY( 10 );
  564.          NoSound;
  565.       END;
  566.  
  567. END   (* Menu_Click *);
  568.  
  569. (*----------------------------------------------------------------------*)
  570. (*                Menu_Beep --- Ring Terminal Bell                      *)
  571. (*----------------------------------------------------------------------*)
  572.  
  573. PROCEDURE Menu_Beep;
  574.  
  575. (*----------------------------------------------------------------------*)
  576. (*                                                                      *)
  577. (*     Procedure:  Menu_Beep                                            *)
  578. (*                                                                      *)
  579. (*     Purpose:    Rings Terminal Bell                                  *)
  580. (*                                                                      *)
  581. (*     Calling Sequence:                                                *)
  582. (*                                                                      *)
  583. (*        Menu_Beep;                                                    *)
  584. (*                                                                      *)
  585. (*     Calls:    None                                                   *)
  586. (*                                                                      *)
  587. (*     Remarks:                                                         *)
  588. (*                                                                      *)
  589. (*        If Menu_Beep_Mode is FALSE, then '<ALERT>' is displayed in    *)
  590. (*        blinking characters on line 25 for 1 second.                  *)
  591. (*                                                                      *)
  592. (*----------------------------------------------------------------------*)
  593.  
  594. VAR
  595.    I        : BYTE;
  596.    J        : BYTE;
  597.    Save_C25 : PACKED ARRAY[1..7] OF CHAR;
  598.    Save_A25 : PACKED ARRAY[1..7] OF INTEGER;
  599.  
  600. BEGIN (* Menu_Beep *)
  601.                                    (* Generate beep if beep mode on *)
  602.    IF Menu_Beep_Mode THEN
  603.       WRITE( Ch_Bell )
  604.    ELSE                            (* Else generate blinking error  *)
  605.       BEGIN
  606.                                    (* Line 25, Column 36 *)
  607.          J     := 3913;
  608.                                    (* Save character, attribute *)
  609.          FOR I := 1 TO 7 DO
  610.             WITH Actual_Screen^ DO
  611.                BEGIN
  612.                   Save_C25[I] := CHR( Screen_Image[ J ] );
  613.                   Save_A25[I] := Screen_Image[ J + 1 ];
  614.                   J           := J + 2;
  615.                END;
  616.                                    (* Display blinking error indicator *)
  617.  
  618.          WriteSXY( '<ALERT>', 36, 25, WHITE + BLINK );
  619.  
  620.          DELAY( 1000 );
  621.                                    (* Restore previous text *)
  622.          FOR I := 1 TO 7 DO
  623.             WriteCXY( Save_C25[I], 35 + I, 25, Save_A25[I] );
  624.  
  625.       END;
  626.  
  627. END   (* Menu_Beep *);
  628.  
  629. (*----------------------------------------------------------------------*)
  630. (*                Menu_Turn_On --- Highlight Menu Choice                *)
  631. (*----------------------------------------------------------------------*)
  632.  
  633. PROCEDURE Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );
  634.  
  635. (*----------------------------------------------------------------------*)
  636. (*                                                                      *)
  637. (*     Procedure:  Menu_Turn_On                                         *)
  638. (*                                                                      *)
  639. (*     Purpose:    Highlight a menu item using reverse video            *)
  640. (*                                                                      *)
  641. (*     Calling Sequence:                                                *)
  642. (*                                                                      *)
  643. (*        Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );         *)
  644. (*                                                                      *)
  645. (*           Menu      : Menu containing item to highlight              *)
  646. (*           Menu_Item : Menu entry to highlight                        *)
  647. (*                                                                      *)
  648. (*     Calls:    GoToXY                                                 *)
  649. (*               RvsVideoOn                                             *)
  650. (*               RvsVideoOff                                            *)
  651. (*                                                                      *)
  652. (*----------------------------------------------------------------------*)
  653.  
  654. BEGIN (* Menu_Turn_On *)
  655.  
  656.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  657.       BEGIN
  658.  
  659.          GoToXY( Menu_Item_Column, Menu_Item_Row );
  660.  
  661.          RvsVideoOn( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  662.  
  663.          WRITE( Menu_Item_Text );
  664.  
  665.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  666.  
  667.       END;
  668.  
  669. END   (* Menu_Turn_On *);
  670.  
  671. (*----------------------------------------------------------------------*)
  672. (*                Menu_Turn_Off --- UnHighlight Menu Choice             *)
  673. (*----------------------------------------------------------------------*)
  674.  
  675. PROCEDURE Menu_Turn_Off( Menu: Menu_Type; Menu_Item : INTEGER );
  676.  
  677. (*----------------------------------------------------------------------*)
  678. (*                                                                      *)
  679. (*     Procedure:  Menu_Turn_Off                                        *)
  680. (*                                                                      *)
  681. (*     Purpose:    Removes highlighting from menu item                  *)
  682. (*                                                                      *)
  683. (*     Calling Sequence:                                                *)
  684. (*                                                                      *)
  685. (*        Menu_Turn_Off( Menu : Menu_Type; Menu_Item : INTEGER );       *)
  686. (*                                                                      *)
  687. (*           Menu        : Menu containing item to unhighlight          *)
  688. (*           RvsVideoOff : Menu entry to un-highlight                   *)
  689. (*                                                                      *)
  690. (*     Calls:    GoToXY                                                 *)
  691. (*                                                                      *)
  692. (*----------------------------------------------------------------------*)
  693.  
  694. BEGIN (* Menu_Turn_Off *)
  695.  
  696.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  697.       BEGIN
  698.  
  699.          GoToXY( Menu_Item_Column , Menu_Item_Row );
  700.  
  701.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  702.  
  703.          WRITE( Menu_Item_Text );
  704.  
  705.       END;
  706.  
  707. END   (* Menu_Turn_Off *);
  708.  
  709. (*----------------------------------------------------------------------*)
  710. (*                Menu_IBMCh --- Interpret IBM keyboard chars.          *)
  711. (*----------------------------------------------------------------------*)
  712.  
  713. PROCEDURE Menu_IBMCh( VAR C : CHAR );
  714.  
  715. (*----------------------------------------------------------------------*)
  716. (*                                                                      *)
  717. (*     Procedure:  Menu_IBMCh                                           *)
  718. (*                                                                      *)
  719. (*     Purpose:    Interpret IBM keyboard chars.                        *)
  720. (*                                                                      *)
  721. (*     Calling Sequence:                                                *)
  722. (*                                                                      *)
  723. (*        Menu_IBMCh( Var C : Char );                                   *)
  724. (*                                                                      *)
  725. (*           C --- On input, char following escape;                     *)
  726. (*                 on output, char revised to Wordstar command code.    *)
  727. (*                                                                      *)
  728. (*     Calls:   None                                                    *)
  729. (*                                                                      *)
  730. (*----------------------------------------------------------------------*)
  731.  
  732. BEGIN  (* Menu_IBMCh *)
  733.  
  734.    READ( Kbd , C );
  735.  
  736.    CASE C OF
  737.  
  738.       'H' : C := Up_arrow;
  739.       'P' : C := Down_arrow;
  740.       ELSE;
  741.  
  742.    END;
  743.  
  744. END   (* Menu_IBMCh *);
  745.  
  746. (*----------------------------------------------------------------------*)
  747. (*                Menu_Display_Choices --- Display Menu Choices         *)
  748. (*----------------------------------------------------------------------*)
  749.  
  750. PROCEDURE Menu_Display_Choices( Menu : Menu_Type );
  751.  
  752. (*----------------------------------------------------------------------*)
  753. (*                                                                      *)
  754. (*     Procedure:  Menu_Display_Choices                                 *)
  755. (*                                                                      *)
  756. (*     Purpose:    Displays Menu Choices                                *)
  757. (*                                                                      *)
  758. (*     Calling Sequence:                                                *)
  759. (*                                                                      *)
  760. (*        Menu_Display_Choices( Menu : Menu_Type );                     *)
  761. (*                                                                      *)
  762. (*           Menu --- Menu record to be displayed.                      *)
  763. (*                                                                      *)
  764. (*     Calls:   ClsScr                                                  *)
  765. (*              GoToXY                                                  *)
  766. (*              Draw_Menu_Frame                                         *)
  767. (*              Save_Screen                                             *)
  768. (*                                                                      *)
  769. (*----------------------------------------------------------------------*)
  770.  
  771. VAR
  772.    I    : INTEGER;
  773.    J    : INTEGER;
  774.    XL   : INTEGER;
  775.    YL   : INTEGER;
  776.    XR   : INTEGER;
  777.    YR   : INTEGER;
  778.    MaxX : INTEGER;
  779.    MaxY : INTEGER;
  780.  
  781. BEGIN (* Menu_Display_Choices *)
  782.  
  783.                                    (* Establish menu size *)
  784.  
  785.    XL := Menu.Menu_Column;
  786.    YL := Menu.Menu_Row;
  787.  
  788.    XR := LENGTH( Menu.Menu_Title ) + XL - 1;
  789.    YR := YL;
  790.  
  791.    MaxX := Menu.Menu_Width;
  792.    MaxY := Menu.Menu_Height;
  793.  
  794.    FOR I := 1 TO Menu.Menu_Size DO
  795.       WITH Menu.Menu_Entries[I] DO
  796.       BEGIN
  797.          IF Menu_Item_Row > MaxY THEN MaxY := Menu_Item_Row;
  798.          J := LENGTH( Menu_Item_Text ) + Menu_Item_Column - 1;
  799.          IF J > MaxX THEN MaxX := J;
  800.       END;
  801.  
  802.    J := XL + MaxX - 1;
  803.    IF J > XR THEN XR := J;
  804.  
  805.    J := YL + MaxY - 1;
  806.    IF J > YR THEN YR := J;
  807.  
  808.    XL := XL - 4;
  809.    IF XL < 0 THEN XL := 0;
  810.  
  811.    YL := YL - 1;
  812.    IF YL < 0 THEN YL := 0;
  813.  
  814.    YR := YR + 1;
  815.    IF YR > 25 THEN YR := 25;
  816.  
  817.    IF XR > 80 THEN XR := 80;
  818.  
  819.                                    (* Save current screen image *)
  820.                                    (* if not already saved      *)
  821.  
  822.    IF Current_Saved_Screen > 0 THEN
  823.       BEGIN
  824.          IF Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen THEN
  825.             Save_Screen( Saved_Screen )
  826.       END
  827.    ELSE
  828.       Save_Screen( Saved_Screen );
  829.  
  830.                                    (* Draw the menu frame       *)
  831.  
  832.    Draw_Menu_Frame( XL, YL, XR, YR, Menu.Menu_FColor, Menu.Menu_TColor,
  833.                     Menu.Menu_Title );
  834.  
  835.                                    (* Display Menu Entries *)
  836.  
  837.    FOR I := 1 TO Menu.Menu_Size DO
  838.       WITH Menu.Menu_Entries[I] DO
  839.          BEGIN
  840.             GoToXY( Menu_Item_Column , Menu_Item_Row );
  841.             WRITE( Menu_Item_Text );
  842.          END;
  843.                                    (* Highlight Default Choice *)
  844.  
  845.    Menu_Turn_On( Menu, Menu.Menu_Default );
  846.  
  847. END   (* Menu_Display_Choices *);
  848.  
  849. (*----------------------------------------------------------------------*)
  850. (*                Menu_Get_Choice --- Get Menu Choice                   *)
  851. (*----------------------------------------------------------------------*)
  852.  
  853. FUNCTION Menu_Get_Choice( Menu: Menu_Type; Erase_After: BOOLEAN ) : INTEGER;
  854.  
  855. (*----------------------------------------------------------------------*)
  856. (*                                                                      *)
  857. (*     Function:  Menu_Get_Choice                                       *)
  858. (*                                                                      *)
  859. (*     Purpose:   Retrieves Menu Choice from current menu               *)
  860. (*                                                                      *)
  861. (*     Calling Sequence:                                                *)
  862. (*                                                                      *)
  863. (*        Ichoice := Menu_Get_Choice( Menu       : Menu_Type;           *)
  864. (*                                    Erase_After: BOOLEAN ) : INTEGER; *)
  865. (*                                                                      *)
  866. (*           Menu        --- Currently displayed menu                   *)
  867. (*           Erase_After --- TRUE to erase menu after choice found      *)
  868. (*           Ichoice     --- Returned menu item chosen                  *)
  869. (*                                                                      *)
  870. (*      Calls:   Menu_Click                                             *)
  871. (*               Menu_IBMCh                                             *)
  872. (*               Menu_Turn_Off                                          *)
  873. (*               Menu_Turn_On                                           *)
  874. (*                                                                      *)
  875. (*      Remarks:                                                        *)
  876. (*                                                                      *)
  877. (*         The current menu item is highlighted in reverse video.       *)
  878. (*         It may be chosen by hitting the return key.  Movement        *)
  879. (*         to other menu items is done using the up-arrow and           *)
  880. (*         down-arrow.                                                  *)
  881. (*                                                                      *)
  882. (*         An item may also be chosen by hitting the first character    *)
  883. (*         of that item.                                                *)
  884. (*                                                                      *)
  885. (*----------------------------------------------------------------------*)
  886.  
  887. VAR
  888.    C       : CHAR;
  889.    Current : INTEGER;
  890.    Last    : INTEGER;
  891.    I       : INTEGER;
  892.    Found   : BOOLEAN;
  893.  
  894. BEGIN  (* Menu_Get_Choice *)
  895.  
  896.    Current := Menu.Menu_Default;
  897.  
  898.    Last    := Current - 1;
  899.    IF Last < 1 THEN Last := Menu.Menu_Size;
  900.  
  901.    REPEAT  (* Loop until return key hit *)
  902.  
  903.                                    (* Read a character *)
  904.       READ( Kbd , C );
  905.       Menu_Click;
  906.       C := UpCase( C );
  907.                                    (* Convert character to menu code *)
  908.       IF C = Ch_Esc THEN Menu_IBMCh( C );
  909.                                    (* Process character *)
  910.       CASE C OF
  911.  
  912.          Down_arrow,
  913.          Space_bar     : BEGIN (* Move down menu *)
  914.                             Last    := Current;
  915.                             Current := Current + 1;
  916.                             IF Current > Menu.Menu_Size THEN
  917.                                Current := 1;
  918.                          END;
  919.  
  920.          Up_arrow      : BEGIN (* Move up menu *)
  921.                             Last    := Current;
  922.                             Current := Current - 1;
  923.                             IF Current < 1 THEN
  924.                                Current := Menu.Menu_Size;
  925.                          END   (* Move up menu *);
  926.  
  927.          Ch_Cr         : ;
  928.  
  929.          ELSE
  930.  
  931.             Found := FALSE;
  932.  
  933.             FOR I := 1 TO Menu.Menu_Size DO
  934.                IF C = UpCase( Menu.Menu_Entries[I].Menu_Item_Text[1] ) THEN
  935.                   BEGIN
  936.                      Found   := TRUE;
  937.                      C       := Ch_Cr;
  938.                      Last    := Current;
  939.                      Current := I;
  940.                   END;
  941.  
  942.             IF ( NOT Found ) THEN Menu_Beep;
  943.  
  944.       END (* Case of C *);
  945.                                    (* Highlight new menu choice *)
  946.  
  947.       IF C IN [ Up_arrow, Down_arrow, Space_bar, Ch_Cr ] THEN
  948.          BEGIN
  949.             Menu_Turn_Off( Menu, Last    );
  950.             Menu_Turn_On ( Menu, Current );
  951.          END;
  952.  
  953.    UNTIL C = Ch_CR;
  954.  
  955.                                    (* Return index of chosen value *)
  956.    Menu_Get_Choice := Current;
  957.  
  958.                                    (* Erase menu from display      *)
  959.    IF Erase_After THEN
  960.       BEGIN                        (* Restore previous screen      *)
  961.          Restore_Screen( Saved_Screen );
  962.                                    (* Restore global colors        *)
  963.          Reset_Global_Colors;
  964.       END;
  965.  
  966. END   (* Menu_Get_Choice *);
  967.